home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / fieldent.zip / FIELDS.PAS < prev    next >
Pascal/Delphi Source File  |  1993-01-04  |  26KB  |  850 lines
  1. {$V-}   (* relaxed string paramater type checking *)
  2.  
  3. Unit Fields;
  4.  
  5.  
  6. (* 
  7.     Screen I/O for fields.
  8.     Based on IBM System 23/Datamaster computer from 1981-1984
  9.  
  10.     code by John Tal
  11.             Rollins Medical/Dental Systems
  12.             Southfield, MI
  13.  
  14.     *******************
  15.     *  Public Domain  *
  16.     *******************
  17.  
  18.  
  19.     Modula-2 versions available in Compuserve Musus sig in JTM2LIB.ARC
  20.     Basic versions for QB4 available from author at RBBS (313) 423-7211
  21.  
  22.     Note:   To Re-Compile this unit you need
  23.  
  24.                Pwindow.Arc
  25.                DosBios.Arc
  26.                Funcs.Arc
  27.  
  28.             All should be available from this Compuserve dl and
  29.             also from the author via  RBBS (313) 423-7211
  30.  
  31.  
  32. *)
  33.  
  34.  
  35.  
  36. (*
  37.  
  38.  
  39.    History behind Fields is in Fields.Me file
  40.  
  41.  
  42.  
  43.    Command String Details
  44.    ----------------------
  45.  
  46.    SCR1$(1) = "02,34,C 08,au," + Ed_nor_str
  47.  
  48.                ^ 02 = 2 digits Y screen location
  49.                   ^ 34 = 2 digits X location
  50.                      ^ C & a space always (C = character data)
  51.                             Although Character data is the only type 
  52.                             currently supported by this emulation, the
  53.                             original types included
  54.  
  55.                                V =  Variable length character data 
  56.                                       ( Trailing blanks dropped )
  57.                    C =  Character
  58.                                       ( Trailing blanks retained )
  59.                    N =  Numeric  
  60.                                       ( 04,04,N 12.2,AU,N  = #########.##
  61.                          ^ field width
  62.                    G =  Both character & numeric
  63.                                        If data is character, acts like V
  64.                                        If data is numeric, acts like N
  65.  
  66.                  PIC =  Picture format, like print using mask
  67.                        ( Not supported on input fields )
  68.  
  69.                         ^ 08 = 2 digits field width
  70.                            ^ au = variable combination of field attributes
  71.                                 upper or lower case.
  72.                              I = invisible
  73.                          U = underline
  74.                          B = blink
  75.                              H = highlight
  76.                          R = reverse
  77.                          N = normal
  78.                          A = auto-exit at end of field
  79.                                           ( goes to next field )
  80.                                     E = auto-return at end of field
  81.                                           ( ii set to -2, end of processing
  82.                                             for all fields in this screen )
  83.  
  84.               This last field is usually a N for normal, but can
  85.               be a two letter combination specifying foreground
  86.               and background colors.   
  87.  
  88.  
  89.               (fB)  foreground color is specified by a lower case letter
  90.                         BACKGROUND color in UPPER CASE
  91.  
  92.               Foreground defined as follows
  93.                    d = Black
  94.                   r = Red
  95.               g = Green
  96.               y = Yellow
  97.                   b = Blue
  98.               m = magenta
  99.               c = cyan
  100.               w = white
  101.  
  102.               Background are the same colors with letters in caps
  103.                   the declaration of bW would be blue letters on a
  104.               white background.   The foreground colors can be
  105.               raised to high intensity by specifying a H in the
  106.               field attribute position defined above.
  107.  
  108.  
  109.                    04,04,C 10,au,yC  =  brown letters on cyan background
  110.                    
  111.                    04,04,C 10,ah,yC  =  yellow letters on cyan background
  112.  
  113.  
  114.  
  115.  
  116.  
  117.  
  118.  
  119.    Color variable definitions
  120.    --------------------------
  121.  
  122.    Integers
  123.  
  124.    colf[fore,0],colf[back,0]   Main Text foreground background
  125.    colf[fore,1],colf[back,1]   Editable field passive colors
  126.    colf[fore,2],colf[back,2]   Editable field active colors
  127.    colf[fore,3],colf[back,3]   Editable field in error (reversed)
  128.    colf[fore,4],colf[back,4]   Main Text in reverse
  129.  
  130.    Strings
  131.  
  132.    Ed_nor_str      Editable field passive colors
  133.    Ed_cur_str      Editable field active colors
  134.    Ed_err_str      Editable field in error (reversed)
  135.    Ed_scr_str      Main Text in reverse
  136.  
  137.  
  138.  
  139. *)
  140.  
  141.  
  142. Interface
  143.   Uses Crt,Funcs,DosBios;
  144.  
  145.  
  146. CONST
  147.   MonoChrome = 1;
  148.   BlackWhite = 2;
  149.   Color = 3;
  150.  
  151.   scr_def_str = 'DBGCRMYWdbgcrmyw';
  152.   fore = 1;
  153.   back = 2;
  154.  
  155.  
  156. TYPE
  157.   st255 = string[255];
  158.   IntAry25 = ARRAY[1..2,0..4] OF Integer;
  159.   StrAry25 = ARRAY[1..2,0..4] OF st255;
  160.   StrAry4 =  ARRAY[1..4] OF st255;
  161.   FrameAry = ARRAY[1..12] OF Byte;
  162.   BoxItAryStr = ARRAY[1..25] Of st255;
  163.  
  164. VAR
  165.   Frame: FrameAry;
  166.  
  167.  
  168.   Procedure FigScreenAttrib(scr_type: Integer; ctrl_atr,disp_atr: st255;
  169.                             VAR text_color,text_bak: Integer; VAR disp_color: BYTE);
  170.  
  171.  
  172.   procedure field_out(scr_type,
  173.                   norm_for,
  174.                   norm_bak: Integer;
  175.                   scr_ctrl,
  176.                   show_data : st255);
  177.  
  178.  
  179.   procedure field_in(scr_type,
  180.                  norm_for,
  181.                  norm_bak: Integer;
  182.                  scr_ctrl: st255;
  183.                var buf78 : st255;
  184.              var flen,ii : integer);
  185.  
  186.  
  187.      Procedure SetIoCol(scr_type: Integer;
  188.                         colf : IntAry25;
  189.                         cols : StrAry25;
  190.                   VAR Intens : StrAry4;
  191.                VAR Ed_cur_str,
  192.                    Ed_nor_str,
  193.                    Ed_err_str,
  194.                    Ed_scr_str : st255);
  195.  
  196.  
  197.       Procedure DrawBox(Frame: FrameAry; Bx,By,Bw,Bh: Integer);
  198.  
  199.       Procedure Boxit(bx,by: Integer;
  200.                        Cout: BoxItAryStr;
  201.                       Cout9,
  202.                        Spac: Integer;
  203.                    VAR Scrf: BoxItAryStr;
  204.                   VAR Scrf9: Integer;
  205.                       Frame: FrameAry;
  206.                        colf: IntAry25;
  207.                    scr_type: Integer;
  208.             VAR rx,ry,rw,rh: BYTE;
  209.                    buff_ptr: scr_buffer_ptr);
  210.  
  211.                         (* paramater breakdown
  212.  
  213.                          Boxit(bx,      = screen X pos (-1 = center)
  214.                                by,      = screen Y pos (-1 = center)
  215.                                Cout,    = array of strings to define screen.
  216.                                           Ascii 196 in string means full horiz bar
  217.                                           Underscores (Ascii 95) denotes input field 
  218.                                Cout9,   = number of cout[]'s defined
  219.                                Spac     = line spacing between entries 
  220.                                           Negative values mean line spacing of 
  221.                                           abs(spac) and each line centered
  222.                                Scrf,    = returned field definitions
  223.                                            (make sure to dim enough)
  224.                                Scrf9,   = number of Scrf[]'s returned
  225.                                Frame,   = array graphic box defs       
  226.                                colf,    = integer color defs   
  227.                    scr_type = screen type                                                                    
  228.                         *)
  229.  
  230.  
  231.       Procedure InitFrame;
  232.  
  233.  
  234.  
  235.  
  236.  
  237. Implementation
  238.  
  239.  
  240.  
  241. Procedure FigScreenAttrib(scr_type: Integer; ctrl_atr,disp_atr: st255;
  242.                           VAR text_color,text_bak: Integer; VAR disp_color: BYTE);
  243. VAR
  244.   col_for,col_bak: Integer;
  245. BEGIN
  246.  
  247.    UpStr(ctrl_atr);
  248.    UpStr(disp_atr);
  249.  
  250.    CASE scr_type OF
  251.        MonoChrome: begin
  252.                       disp_color := 7;
  253.                       if pos('I',ctrl_atr) <> 0 then disp_color := disp_color xor 1;
  254.                       if pos('U',ctrl_atr) <> 0 then disp_color := disp_color xor 6;
  255.                       if pos('B',ctrl_atr) <> 0 then disp_color := disp_color or 16;
  256.                       if pos('H',ctrl_atr) <> 0 then disp_color := disp_color or 8;
  257.                       if pos('R',ctrl_atr) <> 0 then disp_color := 112;
  258.                       if disp_color = 112 then begin
  259.                          text_color := 0;
  260.                          text_bak := 7;
  261.               end
  262.                       ELSE begin
  263.                          text_color := disp_color;
  264.              text_bak := 0;
  265.                       END;
  266.                       if (disp_color >= 17) and (disp_color <> 112) THEN
  267.                          disp_color := disp_color + 112;   { must add 112 to get effect for poke }
  268.  
  269.                    end;
  270.        BlackWhite,Color: begin
  271.                 col_for := Pos(Upcase(disp_atr[1]),scr_def_str)-1;  (* disp = colors *)
  272.                 col_bak := Pos(Upcase(disp_atr[2]),scr_def_str)-1;
  273.         disp_color := col_for + col_bak * 16;
  274.                 text_color := col_for;
  275.                 text_bak := col_bak;
  276.                 if pos('H',ctrl_atr) <> 0 then begin
  277.                    disp_color := disp_color + 8;
  278.                    text_color := text_color + 8;
  279.                 end;
  280.                 (* writeln(disp_color,' ',col_for,' ',col_bak); *)
  281.               end;
  282.    END;
  283.  
  284. END;
  285.  
  286.  
  287.  
  288. procedure field_out;
  289. (* (norm_for,norm_bak,scr_type: Integer; scr_ctrl : st255; show_data : st255); *)
  290. VAR
  291.  scr_y,scr_x,scr_l,i : integer;
  292.  screen_mem_org : integer;
  293.  ca : array[1..5] of st255;
  294.  c,comma,text_color,text_bak : integer;
  295.  disp_color: BYTE;
  296.  disp_atr,ctrl_atr : st255;
  297.  chold : st255;
  298.  col_for,col_bak: Integer;
  299.  vchar,vattrib: Byte;
  300.  command: char;
  301.  
  302.  
  303. begin
  304.  
  305.    chold := scr_ctrl;
  306.    for c := 1 to 5 do                   { pass  1 - isolate y }
  307.    begin                                {       2 - isolate x }
  308.     comma := pos(',',chold);            {       3 - isolate C and width }
  309.     if comma = 0
  310.      then
  311.       comma := length(chold)+1;
  312.     ca[c] := copy(chold,1,comma-1);     {       4 - isolate display attrib }
  313.     chold := copy(chold,comma+1,255);   {       5 - isolate control attrib }
  314.    end;
  315.  
  316.    scr_y := fnval(ca[1]);
  317.    scr_x := fnval(ca[2]);
  318.    scr_l := fnval(right_str(ca[3],2));
  319.  
  320.    disp_atr := ca[4];
  321.    ctrl_atr := ca[5];
  322.  
  323.    FigScreenAttrib(scr_type,disp_atr,ctrl_atr,text_color,text_bak,disp_color);
  324.  
  325.    textcolor(text_color);
  326.    textbackground(text_bak);
  327.  
  328.    gotoxy(scr_x,scr_y);
  329.  
  330.    write(show_data);
  331.  
  332.     for i := scr_x to (scr_x + scr_l - 1) do begin
  333.       Put_CurSor(i,scr_y);
  334.       Get_Vattrib(vchar,vattrib);
  335.       Put_Vattrib(vchar,disp_color);
  336.    end;
  337.  
  338.    textcolor(norm_for);
  339.    textbackground(norm_bak);
  340.  
  341.    gotoxy(scr_x,scr_y);
  342.  
  343. end; {proc outfield}
  344.  
  345.  
  346.  
  347. procedure field_in;
  348. (*  (norm_for,norm_bak,scr_type: Integer; scr_ctrl : st255; var buf78 : st255; var flen,ii : integer); *)
  349. var
  350.  scr_y,scr_x,scr_l : integer;
  351.  cur_y,cur_x : integer;
  352.  screen_mem_org,i,writ_char,move_cursor,action : integer;
  353.  fielding,specialkey : boolean;
  354.  tempx,tempy : integer;
  355.  chold : st255;
  356.  ca : array[1..5] of st255;
  357.  c,comma,text_color,text_bak : integer;
  358.  disp_color: BYTE;
  359.  disp_atr,ctrl_atr : st255;
  360.  command: char;
  361.  vchar,vattrib: byte;
  362.  col_for,col_bak: Integer;
  363.  
  364.  
  365. procedure proc_move_cursor( moveit : integer);
  366. begin
  367.   case moveit of
  368.       1 :  begin                         {move cursor to right}
  369.             cur_x := cur_x + 1;
  370.             if cur_x > (scr_x + scr_l -1)
  371.               then
  372.                 cur_x := scr_x;
  373.             gotoxy(cur_x,cur_y);
  374.            end;
  375.       2 :  begin                         {move cursor to left}
  376.             cur_x := cur_x - 1;
  377.             if cur_x < scr_x
  378.               then
  379.                 cur_x := (scr_x + scr_l - 1);
  380.              gotoxy(cur_x,cur_y);
  381.            end;
  382.    end; {case moveit}
  383. end; {proc_move_cursor}
  384.  
  385.  
  386. procedure proc_writ_char (writ : integer);
  387. begin
  388.  case writ of
  389.    0 : delay(1);
  390.    1 : begin
  391.         gotoxy(cur_x,cur_y);
  392.         write(command);
  393.         if cur_x +1 > (scr_x + scr_l -1)
  394.           then
  395.             gotoxy(scr_x,scr_y);
  396.        end;
  397.    2 : begin
  398.         gotoxy(cur_x,cur_y);
  399.         write(' ');
  400.         gotoxy(cur_x,cur_y);
  401.        end;
  402.    3 : begin
  403.         gotoxy(cur_x,cur_y);
  404.         write(spaces((scr_x + scr_l) - cur_x));
  405.         gotoxy(scr_x,scr_y);
  406.        end;
  407.  end; {case writ}
  408. end; {proc_writ_char}
  409.  
  410.  
  411.  
  412.  begin
  413.  
  414.    chold := scr_ctrl;
  415.    for c := 1 to 5 do begin             { pass  1 - isolate y }
  416.                                         {       2 - isolate x }
  417.     comma := pos(',',chold);            {       3 - isolate C and width }
  418.     if comma = 0
  419.      then
  420.       comma := length(chold)+1;
  421.     ca[c] := copy(chold,1,comma-1);     {       4 - isolate display attrib }
  422.     chold := copy(chold,comma+1,255);   {       5 - isolate control attrib }
  423.    end;
  424.  
  425.    scr_y := fnval(ca[1]);
  426.    scr_x := fnval(ca[2]);
  427.    scr_l := fnval(right_str(ca[3],2));
  428.  
  429.  
  430.    disp_atr := ca[4];
  431.    ctrl_atr := ca[5];
  432.  
  433.    FigScreenAttrib(scr_type,disp_atr,ctrl_atr,text_color,text_bak,disp_color);
  434.  
  435.    gotoxy(scr_x,scr_y);
  436.    writeln(buf78);
  437.  
  438.    for i := scr_x to (scr_x + scr_l - 1) do begin
  439.       Put_Cursor(i,scr_y);
  440.       Get_Vattrib(vchar,vattrib);
  441.       Put_Vattrib(vchar,disp_color);
  442.    end;
  443.  
  444.    gotoxy(scr_x,scr_y);
  445.  
  446.    cur_y := scr_y;
  447.    cur_x := scr_x;
  448.  
  449.    buf78 := spaces(78);
  450.  
  451.   textcolor(text_color);
  452.   textbackground(text_bak);
  453.  
  454.    fielding := true;
  455.    repeat
  456.     if inkey(specialkey,command) Then begin        { if a key has been pressed }
  457.          if not specialkey Then begin              { if not arrow key or tabs }
  458.               if ord(command) in [32..126] Then begin   { if alpha-numeric, accept and print }
  459.                    writ_char := 1;            { write the character }
  460.                    move_cursor := 1;          { move cursor to right }
  461.                    action := 1;               { write/move }
  462.               end
  463.               else                           { not alpha-numeric - not special key }
  464.                 case command of
  465.                   #13 : begin                 { carriage return }
  466.                           fielding := false;  { get out of here }
  467.                           writ_char := 0;     { don't write anything }
  468.                           move_cursor := 0;   { don't move the cursor }
  469.                           action := 0;        { don't do anything }
  470.                           ii := -2;           { flag that infield loop is over }
  471.                         end;
  472.                   #8  : begin                 { back-space }
  473.                           writ_char := 2;     { write a space }
  474.                           move_cursor := 2;   { move to left }
  475.                           action := 3;        { move cursor/write blank/re-pos cur }
  476.                          end;
  477.                   #9  : begin                 { Tab }
  478.                           fielding := false;  { get out of here }
  479.                           writ_char := 0;     { don't write anything }
  480.                           move_cursor := 0;   { don't move the cursor }
  481.                           action := 0;        { don't do anything }
  482.                           ii := ii + 1;       { increment control variable }
  483.                         end;
  484.                   #27 : begin                 { Escape }
  485.                           fielding := false;  { get out of here }
  486.                           writ_char := 3;     { write spaces in field }
  487.                           move_cursor := 0;   { don't move the cursor }
  488.                           action := 4;        { write spaces in field }
  489.                           ii := ii + 1;       { increment control variable }
  490.                         end;
  491.  
  492.                 end; {case command}
  493.           end {if not specialkey}
  494.           else begin
  495.                                              { begin special keys }
  496.                 case command of
  497.                   #75 : begin                 { left arrow }
  498.                          writ_char := 0;      { don't write anything }
  499.                          move_cursor := 2;    { move to left }
  500.                          action := 2;         { just move }
  501.                         end;
  502.                   #77 : begin                 { right arrow }
  503.                          writ_char := 0;      { don't write anything }
  504.                          move_cursor := 1;    { move to right }
  505.                          action := 2;         { just move }
  506.                         end;
  507.                   #72 : begin                 { Up arrow key }
  508.                           fielding := false;  { get out of here }
  509.                           writ_char := 0;     { don't write anything }
  510.                           move_cursor := 0;   { don't move the cursor }
  511.                           action := 0;        { don't do anything }
  512.                           ii := ii - 1;       { decrement control variable }
  513.                         end;
  514.                   #80 : begin                 { Dn arrow key }
  515.                           fielding := false;  { get out of here }
  516.                           writ_char := 0;     { don't write anything }
  517.                           move_cursor := 0;   { don't move the cursor }
  518.                           action := 0;        { don't do anything }
  519.                           ii := ii + 1;       { increment control variable }
  520.                         end;
  521.                   #15  : begin                { shift tab }
  522.                           fielding := false;  { get out of here }
  523.                           writ_char := 0;     { don't write anything }
  524.                           move_cursor := 0;   { don't move the cursor }
  525.                           action := 0;        { don't do anything }
  526.                           ii := ii - 1;       { decrement control variable }
  527.                         end;
  528.                   #65  : halt;                { function key 7 / for testing }
  529.                  end; {case command}
  530.           end; {if specialkey }
  531.  
  532.          case action of
  533.             0 : delay(1);
  534.             1 : begin
  535.                  proc_writ_char(writ_char);
  536.                  proc_move_cursor(move_cursor);
  537.                end;
  538.             2 : proc_move_cursor(move_cursor);
  539.             3 : begin
  540.                  proc_move_cursor(move_cursor);
  541.                  proc_writ_char(writ_char);
  542.                 end;
  543.             4 : proc_writ_char(writ_char);
  544.            end; {case action}
  545.  
  546.        end; {if inkey}
  547.  
  548.    until not fielding;
  549.  
  550.    buf78 := spaces(78);
  551.    for i := scr_x to (scr_x + scr_l - 1) do begin
  552.       Put_Cursor(i,scr_y);
  553.       Get_Vattrib(vchar,vattrib);
  554.       buf78[i-scr_x+1] := chr(ord(vchar));
  555.       (* chr(peek(screen_mem_org,(scr_y-1)*160+(i*2)-2)); *)
  556.       if buf78[i-scr_x+1] = '_' then
  557.          buf78[i-scr_x+1] := ' ';
  558.    end;
  559.  
  560.    buf78 := rtrm(copy(buf78,1,scr_l));
  561.    flen := length(buf78);
  562.    if flen = 0 then begin
  563.       flen := scr_l;
  564.       buf78 := spaces(scr_l);
  565.    end;
  566.  
  567.    textcolor(norm_for);
  568.    textbackground(norm_bak);
  569.  
  570.  end; {infield}
  571.  
  572.  
  573.  
  574. Procedure SetIoCol;(* (scr_type: Integer;
  575.                    colf : IntAry25;
  576.                    cols : StrAry25;
  577.                  Intens : StrAry4;
  578.                 Ed_cur_str,
  579.                 Ed_nor_str,
  580.                 Ed_err_str,
  581.                 Ed_scr_str : st255); *)
  582.  
  583. VAR
  584.   n_str: st255;
  585.   i,temp_int : Integer;
  586. BEGIN
  587.     n_str := 'DBGCRMYW';
  588.  
  589.     For i := 1 TO 4 DO begin
  590.        temp_int := (colf[fore,i] mod 8) + 1;
  591.        cols[fore,i] := chr(ord(n_str[temp_int]) + 32);
  592.        If colf[fore,i] <= 7 Then
  593.           Intens[i] := ''
  594.        ELSE
  595.           Intens[i] := 'h';
  596.  
  597.        cols[back,i] := n_str[(colf[back,i] MOD 8)+ 1];
  598.     END;
  599.  
  600.     If (Scr_type <> Color) Then
  601.        Ed_nor_str := 'au,' + cols[fore,1] + cols[back,1]
  602.     ELSE
  603.        Ed_nor_str := 'a,' + cols[fore,1] + cols[back,1];
  604.  
  605.     Ed_cur_str := 'a' + Intens[2] + ',' + cols[fore,2] + cols[back,2]; {  Cmnd_str := '13,57,C 01,' + Ed_cur_str }
  606.     Ed_err_str := Intens[3] + 'r,' + cols[fore,3] + cols[back,3];       {  Cmnd_str := Copy(Cmnd_str,1,11) + Ed_err_str  }
  607.     Ed_scr_str := Intens[4] + ',' + cols[fore,4] + cols[back,4];
  608. END;
  609.  
  610.  
  611.  
  612.  
  613. Procedure InitFrame;
  614. BEGIN
  615.   frame[1] := 218;
  616.   frame[2] := 196;
  617.   frame[3] := 191;
  618.   frame[4] := 179;
  619.   frame[5] := 192;
  620.   frame[6] := 217;
  621.   frame[7] := 197;
  622.   frame[8] := 195;
  623.   frame[9] := 180;
  624.   frame[10] := 193;
  625.   frame[11] := 194;
  626.   frame[12] := 219;
  627. END;
  628.  
  629.  
  630. Procedure DrawBox;
  631. (* (Frame: FrameAry; Bx,By,Bw,Bh: Integer); *)
  632. VAR
  633.   i : Integer;
  634. BEGIN     
  635.      Gotoxy(Bx,By);
  636.      Write(chr(Frame[1]));
  637.      Write(rpt(BW-2,Frame[2]));
  638.      Write(chr(Frame[3]));
  639.      FOR i := BY+1 TO BY+BH-2 DO begin
  640.        Gotoxy(Bx,i);
  641.        Write(chr(Frame[4]));
  642.        Gotoxy(Bx+Bw-1,i);
  643.        Write(chr(Frame[4]));
  644.      END;
  645.      Gotoxy(Bx,By+Bh-1);
  646.      Write(chr(Frame[5]));
  647.      Write(rpt(Bw-2,Frame[2]));
  648.      Write(Chr(Frame[6]));
  649. END;
  650.  
  651.  
  652. Procedure Boxit;
  653.            (* (bx,by: Integer;
  654.                 Cout: BoxItAryStr;
  655.                 Cout9,
  656.                 Spac: Integer;
  657.             VAR Scrf: BoxItAryStr;
  658.             VAR Scrf9: Integer;
  659.                Frame: FrameAry;
  660.                 colf: IntAry25;
  661.             scr_type: Integer;
  662.          rx,ry,rw,rh: BYTE;
  663.             buff_ptr: Scr_buffer_ptr);
  664.             *)
  665. VAR
  666.   Center,
  667.   Ret_save,
  668.   Dash : BOOLEAN;
  669.   Bw,
  670.   Bh,
  671.   Max_w,
  672.   i,
  673.   Old_Scrf9: Integer;
  674.   A_str,
  675.   D_str: st255;
  676.   Xoffs,
  677.   Apos,
  678.   Dsh,
  679.   Field_start_pos,
  680.   Dlen,
  681.   X,
  682.   J,
  683.   Tempx,
  684.   Tempy,
  685.   Tempw : Integer;
  686.   Ed_scr_str,ED_nor_str,Ed_err_str,Ed_cur_str,disp_atr,ctrl_atr: st255;
  687.   text_color,text_bak: Integer;
  688.   disp_color: BYTE;
  689.   cols: StrAry25;
  690.   Intens : StrAry4;
  691. BEGIN
  692.  
  693.     SetIoCol(scr_type,colf,cols,Intens,Ed_cur_Str,Ed_nor_str,Ed_err_str,Ed_scr_str);
  694.     disp_atr := Copy(Ed_scr_str,1,Pos(',',Ed_scr_str)-1);
  695.     ctrl_atr := Copy(Ed_scr_str,Pos(',',Ed_scr_str)+1,255);
  696.     FigScreenAttrib(scr_type,disp_atr,ctrl_atr,text_color,text_bak,disp_color);
  697.  
  698.     IF Spac <= 0 THEN begin
  699.        Spac := Abs(Spac);
  700.        Center := True;
  701.     end
  702.     ELSE
  703.        Center := FALSE;
  704.  
  705.     IF Cout9 < 0 THEN begin
  706.        Cout9 := Abs(Cout9);
  707.        Ret_save := TRUE;
  708.     end
  709.     ELSE
  710.        Ret_save := FALSE;
  711.  
  712.      Max_W := 0;
  713.      For i := 1 TO Cout9 Do
  714.      Max_W := FnMax(Max_W,Length(COUT[I]));
  715.  
  716.      Bw := Max_W + 6;
  717.  
  718.      Bh := Cout9*Spac + Spac+1;
  719.  
  720.      If Bx = -1 Then   (* FLAG TO CENTER BOX HORIZONTALLY ON SCREEN *)
  721.     BX := 40-(Bw div 2);
  722.  
  723.      IF BY = -1 THEN   (* FLAG TO CENTER BOX VERTICALLY ON SCREEN *)
  724.     BY := 12-(Bh div 2);
  725.  
  726. (*
  727.      IF Ret_Save Then
  728.         GOTO _RSAVE;
  729. *)
  730.  
  731.      TextColor(colf[fore,4]);
  732.      TextBackGround(colf[back,4]);
  733.  
  734.      Rx := Bx;
  735.      Ry := By;
  736.      Rw := Bw;
  737.      Rh := Bh;
  738.      Wget(Bx,By,Bw,Bh,buff_ptr);
  739.       (* save current area under new window/box *)
  740.  
  741.      Scroll_Page_up(Bx,By,Bw,Bh,bh,disp_color);
  742.       (* clear out window/box *)
  743.  
  744.      DrawBox(Frame,Bx,By,Bw,Bh);
  745.  
  746.      Scrf9 := 0;
  747.  
  748.      For i := 1 To Cout9 Do Begin
  749.      Old_Scrf9 := Scrf9;
  750.      A_str := COUT[i];
  751.          If Center Then
  752.             Xoffs := (BW div 2) - (Length(A_str) div 2)
  753.          Else
  754.             Xoffs := 0;
  755.  
  756.          Apos := 1;
  757.            (*  RETAIN CURRENT CHARACTER FOR SCAN, USED TO DETRM FIELD STARTING POS  *)
  758.      Dash := (Pos('_',A_str) > 0);
  759.      While ((Length(A_str) > 1) AND Dash) DO Begin
  760.             (*  ANY FIELDS IN THIS STRING? *)
  761.         If Dash Then begin
  762.            Dsh := Pos('_',A_str);
  763.            Field_Start_Pos := Apos + Dsh - 1;
  764.                  (*  THIS FIELD BEGINS AT CURRENT SCAN POS CHAR IN STRING *)
  765.            Apos := Field_Start_Pos;
  766.                  (*  WE DID AN INSTR, SO WE HAVE TO ADD WHERE IT WAS FOUND TO LAST *)
  767.                  (*  PLACE WE WERE AT  *)
  768.            Scrf9 := Scrf9 + 1;
  769.                  (*  A NEW COMMAND STRING FOR Fields *)
  770.            D_str := Copy(A_str,Dsh,255);
  771.                  (*  ISOLATE BEGINNING OF DASHS FOR SCAN TO DETERMINE TOTAL *)
  772.                  (*  FIELD LENGTH *)
  773.                Dlen := 0;
  774.                  (*  START OFF FIELD LENGTH AS ZERO *)
  775.                WHILE Dash DO begin
  776.               Dlen := Dlen + 1;
  777.           D_str := Copy(D_str,2,255);
  778.           Dash  := (D_str[1] = '_');
  779.                   Apos := Apos + 1;
  780.                     (*  INC OVERALL POSITION IN MAIN STRING   *)
  781.                     (*  CHOP OFF STRING ON LEFT, CHECKING FOR MORE '_'  *)
  782.                   IF length(d_str) = 0 then dash := false;
  783.            END;
  784.            Scrf[Scrf9] := fns_z(By+(i*Spac)) + ',' +
  785.                   fns_z(Bx+Field_Start_Pos+2) + ',C ' +
  786.                               fns_z(Dlen) + ',' + Ed_Nor_str;
  787.  
  788.            IF Center THEN
  789.           Mid_str_assign(Scrf[Scrf9],4,2,fns_z(Bx+Xoffs+Field_Start_Pos-1));
  790.  
  791.  
  792.                (*  BUILD COMMAND STRING *)
  793.            A_str := ' ' + D_str;  (* PLACE HOLDER, RETAINS POS *)
  794.            Apos := Apos - 1;
  795.         END;  (* If Dash *)
  796.             A_str := Copy(A_str,2,255);
  797.         Apos := Apos + 1;
  798.         Dash := (Pos('_',A_str) > 0);
  799.  
  800.      END;
  801.  
  802.          X := Pos('_',COUT[i]);
  803.      While X > 0 DO begin
  804.             COUT[I][X] := ' ';
  805.             X := Pos('_',COUT[i]);
  806.          END;
  807.  
  808.      If COUT[i][1] <> '─' Then begin
  809.         If Center Then
  810.            GotoXy((BX+XOFFS),BY+(I*SPAC))
  811.         Else
  812.            GotoXy((Bx + 3), BY+(I*SPAC));
  813.  
  814.         WriteLn(Cout[i]);
  815.          end
  816.          ELSE begin
  817.             GotoXy(Bx,BY+(I*SPAC));
  818.             Write('├');
  819.             Write(Rpt(BW-2,ord('─')));
  820.             Write('┤');
  821.          END;
  822.  
  823.      TextColor(colf[fore,1]);
  824.          TextBackGround(colf[back,1]);
  825.  
  826.      For J := Old_Scrf9 + 1 To Scrf9 DO begin
  827.        Tempy := fnVAL(Copy(SCRF[J],1,2));
  828.            Tempx := fnVAL(Copy(SCRF[J],4,2));
  829.        TEMPW := fnVAL(Copy(SCRF[J],9,2));
  830.        Gotoxy(Tempx,Tempy);
  831.            Write(' ':Tempw);
  832.          END;
  833.  
  834.          TextColor(colf[fore,4]);
  835.          TextBackground(colf[back,4]);
  836.  
  837.      END;  (* Next I *)
  838.  
  839.      TextColor(colf[fore,0]);
  840.      TextBackground(colf[back,0]);
  841.  
  842.  
  843. END;  (* Boxit *)
  844.  
  845.  
  846.  
  847. END.
  848.  
  849.  
  850.